(* HashSet
 * Copyright (C) 2006 Mario Pernici
 * This software is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public
 * License version 2, as published by the Free Software Foundation.
 * 
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 * 
 * See the GNU Library General Public License version 2 for more details
 * (enclosed in the file LGPL).
 *)
(* Version 0.2 *)
(*
  HashSet is a hashed set, fast on integers and floats, and 
  with O(log N) amortized worst case guarantee for the add, mem and
  remove operations.
  
  The buckets are ordered (only for internal use; HashSet does
  not keep all the elements ordered, unlike Set).
  The first element of a bucket is kept in a separate array v_keys, 
  with occupation controlled by a vector v_occ. Since on average
  more than 60% of the elements are in v_keys, this leads
  to a significant speed-up for integers and floats, which are unboxed.
  The rest of the bucket is a sorted list at creation; if the
  bucket grows beyond limit_list it is converted to a balanced binary tree,
  adapted from the one in Set in the OCaml standard library.
*)
(* Generic interface {{{*)
value limit_list = 30;
value hash = Hashtbl.hash;
type t 'a =
  { 
    v_keys : mutable array 'a;(* v_keys.(i) is the head of bucket if v_occ.(i) is positive *)
    v_occ : mutable array int; (* bucket occupation number *)
    size : mutable int;(* number of elements in the set *)
    data : mutable array (bucket 'a)(* data for keys in bucket, apart from the head of the bucket*)
  }
and bucket 'a =
  [ Empty
  | Cons of 'a and bucket 'a (* list *)
  | Node of bucket 'a and 'a and bucket 'a and int(* tree *)
  ];

(* operations on the buckets in data *)

(* Functions acting on trees end with the suffix _t; 
 * Functions acting on a bucket in data end with _b .
 *) 
value isList_b s =
  match s with [ Empty -> False | Cons _ _ -> True | Node _ _ _ _ -> False ];

value height_t =(*{{{*)
  fun
  [ Empty -> 0
  | Node _ _ _ h -> h
  | Cons _ _ -> invalid_arg "HashSet.height_t" ];(*}}}*)

value create_t l v r =(*{{{*)
  let hl =
    match l with
    [ Empty -> 0
    | Node _ _ _ h -> h
    | Cons _ _ -> invalid_arg "HashSet.create_t" ] in
  let hr =
    match r with
    [ Empty -> 0
    | Node _ _ _ h -> h
    | Cons _ _ -> invalid_arg "HashSet.create_t" ]
  in Node l v r (if hl >= hr then hl + 1 else hr + 1);(*}}}*)

value bal_t l v r =(*{{{*)
  let hl =
    match l with
    [ Empty -> 0
    | Node _ _ _ h -> h
    | Cons _ _ -> invalid_arg "HashSet.bal_t" ] in
  let hr =
    match r with
    [ Empty -> 0
    | Node _ _ _ h -> h
    | Cons _ _ -> invalid_arg "HashSet.bal_t" ]
  in
    if hl > (hr + 2)
    then
      match l with
      [ Empty -> invalid_arg "HashSet.bal_t"
      | Node ll lv lr _ ->
          if (height_t ll) >= (height_t lr)
          then create_t ll lv (create_t lr v r)
          else
            match lr with
            [ Empty -> invalid_arg "HashSet.bal_t"
            | Node lrl lrv lrr _ ->
                create_t (create_t ll lv lrl) lrv (create_t lrr v r)
            | Cons _ _ -> invalid_arg "HashSet.bal_t" ]
      | Cons _ _ -> invalid_arg "HashSet.bal_t" ]
    else
      if hr > (hl + 2)
      then
        match r with
        [ Empty -> invalid_arg "HashSet.bal_t"
        | Node rl rv rr _ ->
            if (height_t rr) >= (height_t rl)
            then create_t (create_t l v rl) rv rr
            else
              match rl with
              [ Empty -> invalid_arg "HashSet.bal_t"
              | Node rll rlv rlr _ ->
                  create_t (create_t l v rll) rlv (create_t rlr rv rr)
              | Cons _ _ -> invalid_arg "HashSet.bal_t" ]
        | Cons _ _ -> invalid_arg "HashSet.bal_t" ]
      else Node l v r (if hl >= hr then hl + 1 else hr + 1); (*}}}*)

(* add_t and add_b are used to add an element x only after checking 
 * that x is not in the set
 *)
value rec add_t x =(*{{{*)
  fun
  [ Empty -> Node Empty x Empty 1
  | (Node l v r _ as t) ->
      let c = compare x v
      in
        if c = 0
        then t
        else if c < 0 then bal_t (add_t x l) v r else bal_t l v (add_t x r)
  | Cons _ _ -> invalid_arg "HashSet.add_t" ];(*}}}*)

value rec add_b x = (*{{{*)
  fun
  [ Empty -> Cons x Empty
  | (Cons k rest as t) ->
      let c = compare x k
      in
        if c < 0
        then Cons x t
        else if c = 0 then t else Cons k (add_b x rest)
  | (Node l v r _ as t) ->
      let c = compare x v
      in
        if c = 0
        then t
        else if c < 0 then bal_t (add_t x l) v r else bal_t l v (add_t x r) ]; (*}}}*)


value rec min_elt_t = (*{{{*)
  fun
  [ Empty -> raise Not_found
  | Node Empty v r _ -> v
  | Node l v r _ -> min_elt_t l
  | Cons _ _ -> invalid_arg "HashSet.min_elt_t" ];(*}}}*)

value rec remove_min_elt_t = (*{{{*)
  fun
  [ Empty -> invalid_arg "HashSet.remove_min_elt_t"
  | Node Empty v r _ -> r
  | Node l v r _ -> bal_t (remove_min_elt_t l) v r
  | Cons _ _ -> invalid_arg "HashSet.remove_min_elt_t" ];(*}}}*)

value merge_t t1 t2 = (*{{{*)
  match (t1, t2) with
  [ (Empty, t) -> t
  | (t, Empty) -> t
  | (Cons _ _, _) -> invalid_arg "HashSet.merge_t"
  | (_, Cons _ _) -> invalid_arg "HashSet.merge_t"
  | (_, _) -> bal_t t1 (min_elt_t t2) (remove_min_elt_t t2) ]; (*}}}*)

value rec mem_b key = (*{{{*)
  fun
  [ Empty -> False
  | Cons k rest ->
      let c = compare key k
      in if c = 0 then True else if c < 0 then False else mem_b key rest
  | Node l v r _ ->
      let c = compare key v
      in (c = 0) || (mem_b key (if c < 0 then l else r)) ]; (*}}}*)

value rec remove_b key s = (*{{{*)
  match s with
  [ Empty -> Empty
  | Cons k rest ->
      let c = compare key k
      in
        if c < 0
        then s
        else if c = 0 then rest else Cons k (remove_b key rest)
  | Node l v r _ ->
      let c = compare key v
      in
        if c = 0
        then merge_t l r
        else
          if c < 0
          then bal_t (remove_b key l) v r
          else bal_t l v (remove_b key r) ]; (*}}}*)

value rec iter_b f = (*{{{*)
  fun
  [ Empty -> ()
  | Cons k rest -> (f k; iter_b f rest)
  | Node l v r _ -> (iter_b f l; f v; iter_b f r) ];(*}}}*)

value rec fold_b f s accu = (*{{{*)
  match s with
  [ Empty -> accu
  | Cons k rest -> fold_b f rest (f k accu)
  | Node l v r _ -> fold_b f r (f v (fold_b f l accu)) ]; (*}}}*)

value rec for_all_b p s = (*{{{*)
  match s with
  [ Empty -> True
  | Cons k rest -> (p k) && (for_all_b p rest)
  | Node l v r _ -> (p v) && ((for_all_b p l) && (for_all_b p r)) ];(*}}}*)

value rec exists_b p = (*{{{*)
  fun
  [ Empty -> False
  | Cons k rest -> (p k) || (exists_b p rest)
  | Node l v r _ -> (p v) || ((exists_b p l) || (exists_b p r)) ]; (*}}}*)

value tree_of_list_b s = (*{{{*)
  let get_pair =
    fun
    [ Empty -> invalid_arg "HashSet.tree_of_list"
    | Cons k rest -> ((Node Empty k Empty 1), rest)
    | Node _ _ _ _ -> invalid_arg "HashSet.tree_of_list" ] in
  let (n, l) = get_pair s in
  let rn = ref n in (iter_b (fun k -> rn.val := add_t k rn.val) l; rn.val); (*}}}*)
(*   *)
value empty () = (*{{{*)
  { v_keys = [|  |]; v_occ = [| 0 |]; size = 0; data = [| Empty |]; }; (*}}}*)

(* k0 default key; needed to create v_keys
 *  with the required type. When v_occ.(i) is zero, v_keys.(i)
 *  is a fake key, which is k0 or some other value.
 *)
value create initial_size = (*{{{*)
  let s = min (max 1 initial_size) Sys.max_array_length
  in
    {
      v_keys = Array.make s (Obj.magic ());
      v_occ = Array.make s 0;
      size = 0;
      data = Array.make s Empty;
    };(*}}}*)

value singleton key = { v_keys = [| key |]; v_occ = [| 1 |]; size = 1; data = [| Empty |]; };
value length h = h.size;
value is_empty h = h.size = 0;
value capacity h = Array.length h.v_keys;

value mem h key = (*{{{*)
  try
    let i = (hash key) mod (Array.length h.v_keys)
    in
      if h.v_occ.(i) > 0
      then
        let c = compare key h.v_keys.(i)
        in
          if c < 0
          then False
          else if c = 0 then True else mem_b key h.data.(i)
      else False
  with [ Division_by_zero -> False ];(*}}}*)

(* for efficiency reasons the keys in v_keys are not deleted,
 * but "unlinked" setting the corresponding h.v_occ.(i) is zero
 *)
value clear h = (*{{{*)
  (if (length h) <> 0
   then
     for i = 0 to (Array.length h.v_keys) - 1 do
       h.v_keys.(i) := Obj.magic ();
       h.v_occ.(i) := 0;
       h.data.(i) := Empty
     done
   else ();
   h.size := 0);(*}}}*)

(* make a copy, keeping the same internal structure *)
value copy h = (*{{{*)
  if (length h) = 0
  then empty ()
  else
    let n = Array.length h.data in
    let nv_keys = Array.create n h.v_keys.(0) in
    let nv_occ = Array.create n 0 in
    let ndata = Array.create n Empty
    in
      (for i = 0 to n - 1 do
         if h.v_occ.(i) > 0
         then
           (nv_keys.(i) := h.v_keys.(i);
            nv_occ.(i) := h.v_occ.(i);
            ndata.(i) := h.data.(i))
         else ()
       done;
       { v_keys = nv_keys; v_occ = nv_occ; size = h.size; data = ndata; });(*}}}*)

(* iterate on the buckets *)
value iter_buckets f h = let d = h.data in for i = 0 to (Array.length d) - 1 do iter_b f d.(i) done;

(* iterate on v_keys *)
value iter_v f h = (*{{{*)
  let v_occ = h.v_occ
  in
    for i = 0 to (Array.length h.v_keys) - 1 do
      if v_occ.(i) > 0 then f h.v_keys.(i) else ()
    done;(*}}}*)

value iter f h = (iter_v f h; iter_buckets f h);
type enum_mode = [ Keys | Buckets | Bucket ];
value enum h = (*{{{*)
  let rec make mode i =
    let cb = ref [] in
    let rc = ref h.size
    in
      Enum.make
        ~next:
          (
            fun () ->
              let rec read_bucket () =
                match cb.val with
                [ [] | [ Empty ] -> read_buckets ()
                | [ b :: bckts ] ->
                  match b with
                  [ Empty -> (cb.val := bckts; read_bucket ())
                  | Cons k rest -> (cb.val := [ rest :: bckts ]; k)
                  | Node l v r _ -> (cb.val := [ l; r :: bckts ]; v) 
                  ] 
                ]
              and read_buckets () =
                if i.val < (Array.length h.data)
                then
                (
                  cb.val := [ h.data.(i.val) ];
                  incr i;
                  mode.val := Bucket;
                  read_bucket ()
                )
                else raise Enum.No_more_elements 
              in
              let rec read_key () =
                if i.val < (Array.length h.v_keys)
                then
                  if h.v_occ.(i.val) > 0
                  then let e = h.v_keys.(i.val) in (incr i; e)
                  else ( incr i; read_key ())
                else 
                (
                  i.val := 0; 
                  mode.val := Buckets; 
                  read_bucket ()
                ) 
              in
              let v =
                match mode.val with
                [ Keys -> read_key ()
                | Buckets -> read_bucket ()
                | Bucket -> read_bucket () 
                ]
              in 
              (decr rc; v)
            )
        ~count: (fun () -> rc.val)
        ~clone: (fun () -> make (ref mode.val) (ref i.val))
  in make (ref Keys) (ref 0);(*}}}*)

(* 
 * It is "unsafe" in the sense that no checking is made that
 * no resizing is made.
 *)
value add_unsafe h key = (*{{{*)
  let i = (hash key) mod (Array.length h.v_keys)
  in
    if h.v_occ.(i) = 0
    then (h.v_occ.(i) := 1; h.v_keys.(i) := key; h.size := succ h.size)
    else
      ((* convert to tree if the list is too long *)
       if (h.v_occ.(i) > limit_list) && (isList_b h.data.(i))
       then h.data.(i) := tree_of_list_b h.data.(i)
       else ();
       let c = compare key h.v_keys.(i);
       if c < 0
       then
         (h.size := succ h.size;
          h.v_occ.(i) := succ h.v_occ.(i);
          h.data.(i) := add_b h.v_keys.(i) h.data.(i);
          h.v_keys.(i) := key)
       else
         if c > 0
         then
           if not (mem_b key h.data.(i))
           then
             (h.size := succ h.size;
              h.v_occ.(i) := succ h.v_occ.(i);
              h.data.(i) := add_b key h.data.(i))
           else ()
         else ());(*}}}*)

(* nsize is supposed to be >= (length h) *)
value copy_resize h nsize = (*{{{*)
  let h2 = create nsize (* h.v_keys.(0) *) in 
  (iter (fun key -> add_unsafe h2 key) h; h2);

(* resize to (2 * oldsize + 1)  *)
value resize h key =
  let osize = Array.length h.v_keys
  in
    if osize = 0
    then
      (h.v_keys := [| key |];
       h.v_occ := [| 0 |];
       h.size := 0;
       h.data := [| Empty |])
    else
      let nsize = min ((2 * osize) + 1) Sys.max_array_length
      in
        if nsize <> osize
        then
          let hc = copy_resize h nsize
          in
            (h.v_keys := hc.v_keys;
             h.v_occ := hc.v_occ;
             h.size := hc.size;
             h.data := hc.data)
        else ();(*}}}*)

value add h key = 
(
  if h.size >= (Array.length h.v_keys) then resize h key else ();
  add_unsafe h key
);

value remove h key = (*{{{*)
  let length = Array.length h.v_keys in
  if length > 0
  then
    let i = (hash key) mod length in
    if h.v_occ.(i) > 0
    then
      let c = compare key h.v_keys.(i)
      in
        if c = 0
        then
        (
          h.size := pred h.size;
          h.v_occ.(i) := pred h.v_occ.(i);
          match h.data.(i) with
          [ Empty -> h.v_keys.(i) := Obj.magic ()
          | Cons k1 next -> 
            (
              h.data.(i) := next; 
              h.v_keys.(i) := k1
            )
          | (Node l v r n as t) ->
              let k1 = min_elt_t t in 
              (
                h.data.(i) := remove_b k1 t; 
                h.v_keys.(i) := k1
              )
          ]
        )
        else
          if c > 0
          then (* remove key from data *)
            if mem_b key h.data.(i)
            then
            (
              h.size := pred h.size;
              h.v_occ.(i) := pred h.v_occ.(i);
              h.data.(i) := remove_b key h.data.(i)
            )
            else ()
          else ()
    else ()
  else ();(*}}}*)

exception Break;
value choose h = (*{{{*)
  let f = ref None
  in
  (
    try
      let v_occ = h.v_occ in
      for i = 0 to (Array.length h.v_keys) - 1 do
        if v_occ.(i) > 0
        then (f.val := Some h.v_keys.(i); raise Break)
        else ()
      done
    with [ Break -> () ];
    f.val
  );(*}}}*)

value pop h =
  match choose h with [ (Some e as r) -> (remove h e; r) | r -> r ];

value of_list lst =
  let h = empty () in (List.iter (fun x -> add h x) lst; h);

value bucket_lengths h = (*{{{*)
  let num_bucketr = ref 0
  in
  (
    for i = 0 to (Array.length h.v_occ) - 1 do
       if h.v_occ.(i) > 0 then incr num_bucketr else ()
    done;
    let a = Array.make num_bucketr.val 0;
    let c = ref 0;
    for i = 0 to (Array.length h.v_occ) - 1 do
      if h.v_occ.(i) > 0 then (a.(c.val) := h.v_occ.(i); incr c) else ()
    done;
    a
  );(*}}}*)

value fold f h init =
  let accu = ref init
  in (iter (fun key -> accu.val := f key accu.val) h; accu.val);

value to_list h = fold (fun e l -> [ e :: l ]) h [];

value to_array h = 
  match choose h with
  [ None -> [||]
  | Some e ->
      let arr = Array.make h.size e in
      let i = ref 0 in
      (
        iter begin fun e -> 
          (
            Array.unsafe_set arr !i e;
            incr i
          ) 
        end h;
        arr
      )
  ];

value for_all p h =
  let predq key = if not (p key) then raise Not_found else () in
  let res = ref True in
  let _ = try iter predq h with [ Not_found -> res.val := False ] in res.val;

value exists p h =
  let predq key = if p key then raise Not_found else () in
  (* Found, really *)
  let res = ref False in
  let _ = try iter predq h with [ Not_found -> res.val := True ] in res.val;

value keys h =
  let a = Array.make h.size h.v_keys.(0) in
  let i = ref 0 in (iter (fun key -> (a.(i.val) := key; incr i)) h; a);

value equal h other = (*{{{*)
  if h.size <> other.size
  then False
  else
    let memq key = if not (mem other key) then raise Not_found else () in
    let res = ref True in
    let _ = try iter memq h with [ Not_found -> res.val := False ] in res.val;
(*}}}*)

(* set operations, inplace *)
value update h other = let add_to key = add h key in iter add_to other;

value diff_update h other =
  try
    iter_buckets (fun x -> remove h x) other;
    iter_v (fun x -> remove h x) other;
  with [ Break -> () ];

value symmetric_diff_update h other =
  let xor key = if mem h key then remove h key else add h key
  in iter xor other;

value inter_update h other =
  let f key = if not (mem other key) then remove h key else ()
  in
   (* removing first the keys in data is faster, since removing
   * keys from v_keys.(i) when there are other keys in the bucket is slow
   *)
  (
    iter_buckets f h; 
    iter_v f h
  );

(* set operations, non inplace *)
value union h other = let r = copy h in (update r other; r);
value diff h other = let r = copy h in (diff_update r other; r);
value symmetric_diff h other =
  let r = copy h in (symmetric_diff_update r other; r);
value inter h other = let r = copy h in (inter_update r other; r);
(*}}}*)

(* Functorial interface {{{*)
module type HashedType =
  sig type t; value compare : t -> t -> int; value hash : t -> int; end;

module type S = (*{{{*)
  sig
    type elt;
    type t;
    value empty : unit -> t;
    value create : int -> t;
    value length : t -> int;
    value is_empty : t -> bool;
    value capacity : t -> int;
    value mem : t -> elt -> bool;
    value clear : t -> unit;
    value copy : t -> t;
    value iter_v : (elt -> unit) -> t -> unit;
    value iter : (elt -> unit) -> t -> unit;
    value add_unsafe : t -> elt -> unit;
    value copy_resize : t -> int -> t;
    value resize : t -> elt -> unit;
    value add : t -> elt -> unit;
    value remove : t -> elt -> unit;
    value choose : t -> option elt;
    value pop : t -> option elt;
    value of_list : list elt -> t;
    value to_list : t -> list elt;
    value enum : t -> Enum.t elt;
    value bucket_lengths : t -> array int;
    value fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a;
    value for_all : (elt -> bool) -> t -> bool;
    value exists : (elt -> bool) -> t -> bool;
    value keys : t -> array elt;
    value equal : t -> t -> bool;
    value update : t -> t -> unit;
    value diff_update : t -> t -> unit;
    value symmetric_diff_update : t -> t -> unit;
    value inter_update : t -> t -> unit;
    value union : t -> t -> t;
    value diff : t -> t -> t;
    value symmetric_diff : t -> t -> t;
    value inter : t -> t -> t;
  end;(*}}}*)

module Make (H : HashedType) : S with type elt = H.t = (*{{{*)
  struct
    type elt = H.t;
    type set = t elt;
    type t = set;
    value safehash key = (H.hash key) land max_int;
    value isList_b = isList_b;
    value height_t = height_t;
    value create_t = create_t;
    value bal_t = bal_t;

    value rec add_t x = (*{{{*)
      fun
      [ Empty -> Node Empty x Empty 1
      | (Node l v r _ as t) ->
          let c = H.compare x v
          in
            if c = 0
            then t
            else
              if c < 0 then bal_t (add_t x l) v r else bal_t l v (add_t x r)
      | Cons _ _ -> invalid_arg "HashSet.add_t" ];(*}}}*)

    value rec add_b x = (*{{{*)
      fun
      [ Empty -> Cons x Empty
      | (Cons k rest as t) ->
          let c = H.compare x k
          in
            if c < 0
            then Cons x t
            else if c = 0 then t else Cons k (add_b x rest)
      | (Node l v r _ as t) ->
          let c = H.compare x v
          in
            if c = 0
            then t
            else
              if c < 0 then bal_t (add_t x l) v r else bal_t l v (add_t x r) ];
    (*}}}*)

    value min_elt_t = min_elt_t;
    value remove_min_elt_t = remove_min_elt_t;
    value merge_t = merge_t;

    value rec mem_b key = (*{{{*)
      fun
      [ Empty -> False
      | Cons k rest ->
          let c = H.compare key k
          in if c = 0 then True else if c < 0 then False else mem_b key rest
      | Node l v r _ ->
          let c = H.compare key v
          in (c = 0) || (mem_b key (if c < 0 then l else r)) ];
    value rec remove_b key s =
      match s with
      [ Empty -> Empty
      | Cons k rest ->
          let c = H.compare key k
          in
            if c < 0
            then s
            else if c = 0 then rest else Cons k (remove_b key rest)
      | Node l v r _ ->
          let c = H.compare key v
          in
            if c = 0
            then merge_t l r
            else
              if c < 0
              then bal_t (remove_b key l) v r
              else bal_t l v (remove_b key r) ];
    (*}}}*)

    value iter_b = iter_b;
    value fold_b = fold_b;
    value for_all_b = for_all_b;
    value exists_b = exists_b;
    value bucket_lengths = bucket_lengths;
    value tree_of_list_b s = (*{{{*)
      let get_pair =
        fun
        [ Empty -> invalid_arg "HashSet.tree_of_list"
        | Cons k rest -> ((Node Empty k Empty 1), rest)
        | Node _ _ _ _ -> invalid_arg "HashSet.tree_of_list" ] in
      let (n, l) = get_pair s in
      let rn = ref n
      in (iter_b (fun k -> rn.val := add_t k rn.val) l; rn.val);
    (*}}}*)

    value empty = empty;
    value create = create;
    value length = length;
    value is_empty = is_empty;
    value capacity = capacity;

    value mem h key = (*{{{*)
      try
        let i = (safehash key) mod (Array.length h.v_keys)
        in
          if h.v_occ.(i) > 0
          then
            let c = H.compare key h.v_keys.(i)
            in
              if c < 0
              then False
              else if c = 0 then True else mem_b key h.data.(i)
          else False;
      with [ Division_by_zero -> False ];(*}}}*)

    value clear = clear;
    value copy = copy;
    value iter_buckets = iter_buckets;
    value iter_v = iter_v;
    value iter = iter;
    value add_unsafe h key = (*{{{*)
      let i = (safehash key) mod (Array.length h.v_keys)
      in
        if h.v_occ.(i) = 0
        then (h.v_occ.(i) := 1; h.v_keys.(i) := key; h.size := succ h.size)
        else
          ((*  convert to tree if the list is too long *)
           if (h.v_occ.(i) > limit_list) && (isList_b h.data.(i))
           then h.data.(i) := tree_of_list_b h.data.(i)
           else ();
           let c = H.compare key h.v_keys.(i);
           if c < 0
           then
             (h.size := succ h.size;
              h.v_occ.(i) := succ h.v_occ.(i);
              h.data.(i) := add_b h.v_keys.(i) h.data.(i);
              h.v_keys.(i) := key)
           else
             if c > 0
             then
               if not (mem_b key h.data.(i))
               then
                 (h.size := succ h.size;
                  h.v_occ.(i) := succ h.v_occ.(i);
                  h.data.(i) := add_b key h.data.(i))
               else ()
             else ());(*}}}*)

    value copy_resize h nsize =
      let h2 = create nsize (* h.v_keys.(0) *) in 
      (iter (fun key -> add_unsafe h2 key) h; h2);

    value resize h key = (*{{{*)
      let osize = Array.length h.v_keys in
      let nsize = min ((2 * osize) + 1) Sys.max_array_length
      in
        if osize = 0
        then
          (h.v_keys := [| key |];
           h.v_occ := [| 0 |];
           h.size := 0;
           h.data := [| Empty |])
        else
          if nsize <> osize
          then
            let hc = copy_resize h nsize
            in
              (h.v_keys := hc.v_keys;
               h.v_occ := hc.v_occ;
               h.size := hc.size;
               h.data := hc.data)
          else ();
    (*}}}*)

    value add h key =
    (
      if h.size >= (Array.length h.v_keys) then resize h key else ();
      add_unsafe h key
    );

    value remove h key = (*{{{*)
      let i = (safehash key) mod (Array.length h.v_keys)
      in
        if h.v_occ.(i) > 0
        then
          let c = H.compare key h.v_keys.(i)
          in
            if c = 0
            then
            (
              h.size := pred h.size;
              h.v_occ.(i) := pred h.v_occ.(i);
              match h.data.(i) with
              [ Empty -> h.v_keys.(i) := Obj.magic ()
              | Cons k1 next -> (h.data.(i) := next; h.v_keys.(i) := k1)
              | (Node l v r n as t) ->
                  let k1 = min_elt_t t in 
                  (
                    h.data.(i) := remove_b k1 t; 
                    h.v_keys.(i) := k1
                  )
              ]
            )
            else
              if c > 0
              then (* remove key from data *)
                if mem_b key h.data.(i)
                then
                (
                  h.size := pred h.size;
                  h.v_occ.(i) := pred h.v_occ.(i);
                  h.data.(i) := remove_b key h.data.(i)
                )
                else ()
              else ()
        else ();
    (*}}}*)


    value choose = choose;
    value pop h =
      match choose h with [ (Some e as r) -> (remove h e; r) | r -> r ];

    value of_list lst = let h = empty () in (List.iter (fun x -> add h x) lst; h);
    value to_list = to_list;
    value enum = enum;

    value fold = fold;
    value for_all = for_all;
    value exists = exists;
    value keys = keys;

    value equal h other = (*{{{*)
      if h.size <> other.size
      then False
      else
        let memq key = if not (mem other key) then raise Not_found else () in
        let res = ref True in
        let _ = try iter memq h with [ Not_found -> res.val := False ]
        in res.val;
      (*}}}*)    
        
    (* set operations, inplace *)
    value update h other = let add_to key = add h key in iter add_to other;
    value diff_update h other =
      (iter_buckets (fun x -> remove h x) other;
       iter_v (fun x -> remove h x) other);
    value symmetric_diff_update h other =
      let xor key = if mem h key then remove h key else add h key
      in iter xor other;
    value inter_update h other =
      let f key = if not (mem other key) then remove h key else ()
      in (iter_buckets f h; iter_v f h);
    (* set operations, non inplace *)
    value union h other = let r = copy h in (update r other; r);
    value diff h other = let r = copy h in (diff_update r other; r);
    value symmetric_diff h other =
      let r = copy h in (symmetric_diff_update r other; r);
    value inter h other = let r = copy h in (inter_update r other; r);
  end;(*}}}*)
(*}}}*)

